home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / pas / swag / win_os2.swg / 0014_Windows 3-D frames.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-26  |  12KB  |  297 lines
  1. { Frames unit - a set of comprehensive (for my purposes) functions for
  2.         drawing pretty 3-D frames of all types. Pretty simple stuff - I'm sure
  3.         you will be able to figure it out - but that's why I included it.
  4.         As always, you are welcome to do whatever with this unit. I only ask that
  5.         if you upload it somewhere modified, keep my name off it, so I don't have
  6.         to answer for your bad code <grin>. If you have any suggestions or
  7.         questions, by all means send them to me - I'd love to hear from a fellow
  8.         programmer.
  9.                 Steve Willer
  10.                 Mark Data Management
  11.                 CIS: 70400,3667
  12.                 AOL: SteveWill
  13. }
  14.  
  15. unit frames;
  16.  
  17. interface
  18. uses WinTypes,WinProcs,WinDOS;
  19. procedure DrawBorderFrame(PaintDC:HDC;PaintR:TRect;Back:boolean);
  20. procedure DrawOutFrame(PaintDC:HDC;PaintR:TRect;Back:boolean;Width:integer);
  21. procedure DrawInFrame(PaintDC:HDC;PaintR:TRect;Back:boolean;Width:integer);
  22. procedure DrawDivLine(PaintDC:HDC;Y:integer;Width:integer);
  23. procedure DrawDotLine(PaintDC:HDC;PaintR:TRect;Incr:integer);
  24. function MakeBorBrush(HWindow:HWnd;BackColor1,BackColor2:TColorRef):HBrush;
  25. procedure DrawExplodeFrame(PaintDC:HDC;ExplR:TRect;PenColor,BrushColor:TColorRef;DrawBrush:boolean;Width:integer;
  26.                                 Steps:integer;Pause:longint);
  27.  
  28. implementation
  29. procedure DrawBorderFrame(PaintDC:HDC;PaintR:TRect;Back:boolean);
  30. var ThePen,OldPen:HPen;
  31.                 FillBrush,OldBrush:HBrush;
  32. begin
  33.         if Back then
  34.         begin
  35.                 FillBrush := CreateSolidBrush($00C0C0C0);
  36.                 OldBrush := SelectObject(PaintDC,FillBrush);
  37.                 InflateRect(PaintR,-1,-1);
  38.                 FillRect(PaintDC,PaintR,FillBrush);
  39.                 InflateRect(PaintR,1,1);
  40.                 SelectObject(PaintDC,OldBrush);
  41.                 DeleteObject(FillBrush);
  42.         end;
  43.  
  44.         OldBrush := SelectObject(PaintDC,GetStockObject(Null_Brush));
  45.         ThePen := CreatePen(ps_Solid,1,$00C0C0C0);
  46.         OldPen := SelectObject(PaintDC,ThePen);
  47.         PaintR.top:=PaintR.top+1;
  48.         PaintR.left:=PaintR.left-1;
  49.         Rectangle(PaintDC,PaintR.left,PaintR.top,PaintR.right,PaintR.bottom);
  50.         PaintR.top:=PaintR.top-1;
  51.         PaintR.left:=PaintR.left+1;
  52.         SelectObject(PaintDC,OldPen);
  53.         DeleteObject(ThePen);
  54.         SelectObject(PaintDC,OldBrush);
  55.  
  56.         ThePen := CreatePen(ps_Solid,1,RGB(255,255,255));
  57.         OldPen := SelectObject(PaintDC,ThePen);
  58.         MoveTo(PaintDC,PaintR.right,PaintR.top);
  59.         LineTo(PaintDC,PaintR.left,PaintR.top);
  60.         LineTo(PaintDC,PaintR.left,PaintR.bottom);
  61.         MoveTo(PaintDC,PaintR.left+2,PaintR.bottom-2);
  62.         LineTo(PaintDC,PaintR.right-2,PaintR.bottom-2);
  63.         LineTo(PaintDC,PaintR.right-2,PaintR.top+2);
  64.         SelectObject(PaintDC,OldPen);
  65.         DeleteObject(ThePen);
  66.  
  67.         ThePen := CreatePen(ps_Solid,1,RGB(127,127,127));
  68.         OldPen := SelectObject(PaintDC,ThePen);
  69.         MoveTo(PaintDC,PaintR.right-2,PaintR.top+2);
  70.         LineTo(PaintDC,PaintR.left+2,PaintR.top+2);
  71.         LineTo(PaintDC,PaintR.left+2,PaintR.bottom-3);
  72.         MoveTo(PaintDC,PaintR.left,PaintR.bottom);
  73.         LineTo(PaintDC,PaintR.right,PaintR.bottom);
  74.         LineTo(PaintDC,PaintR.right,PaintR.top);
  75.         SelectObject(PaintDC,OldPen);
  76.         DeleteObject(ThePen);
  77. end;
  78.  
  79. procedure DrawOutFrame (PaintDC:HDC; PaintR:TRect; Back:boolean; Width:integer);
  80. var
  81.         ThePen, OldPen:HPen;
  82.         FillBrush, OldBrush:HBrush;
  83.         count:integer;
  84.         CalcR:TRect;
  85. begin
  86. if Back then
  87.         begin
  88.         FillBrush := CreateSolidBrush ($00C0C0C0);
  89.         OldBrush := SelectObject(PaintDC,FillBrush);
  90.         InflateRect (PaintR, -1*(Width)+1, -1*(Width)+1);
  91.         FillRect (PaintDC,PaintR,FillBrush);
  92.         InflateRect (PaintR,Width-1,Width-1);
  93.         SelectObject (PaintDC,OldBrush);
  94.         DeleteObject (FillBrush);
  95.         end;
  96.  
  97. CalcR := PaintR;
  98.  
  99. for count:=0 to (Width-1) do
  100.         begin
  101.         PaintR := CalcR;
  102.         InflateRect (PaintR, -1*(count), -1*(count));
  103.  
  104.         ThePen := CreatePen(ps_Solid,1,RGB(255,255,255));
  105.         OldPen := SelectObject(PaintDC,ThePen);
  106.         MoveTo (PaintDC,PaintR.right,PaintR.top);
  107.         LineTo (PaintDC,PaintR.left,PaintR.top);
  108.         LineTo (PaintDC,PaintR.left,PaintR.bottom+1);
  109.         SelectObject (PaintDC,OldPen);
  110.         DeleteObject (ThePen);
  111.  
  112.         ThePen := CreatePen (ps_Solid,1,RGB(127,127,127));
  113.         OldPen := SelectObject (PaintDC,ThePen);
  114.         MoveTo (PaintDC,PaintR.right,PaintR.top+1);
  115.         LineTo (PaintDC,PaintR.right,PaintR.bottom);
  116.         LineTo (PaintDC,PaintR.left,PaintR.bottom);
  117.         SelectObject (PaintDC,OldPen);
  118.         DeleteObject (ThePen);
  119.         end;
  120. end;
  121.  
  122. procedure DrawInFrame(PaintDC:HDC;PaintR:TRect;Back:boolean;Width:integer);
  123. var ThePen,OldPen:HPen;
  124.                 FillBrush,OldBrush:HBrush;
  125.                 count:integer;
  126.                 CalcR:TRect;
  127. begin
  128.         if Back then
  129.         begin
  130.                 FillBrush := CreateSolidBrush($00C0C0C0);
  131.                 OldBrush := SelectObject(PaintDC,FillBrush);
  132.                 InflateRect(PaintR,-1*(Width)+1,-1*(Width)+1);
  133.                 FillRect(PaintDC,PaintR,FillBrush);
  134.                 InflateRect(PaintR,Width-1,Width-1);
  135.                 SelectObject(PaintDC,OldBrush);
  136.                 DeleteObject(FillBrush);
  137.         end;
  138.  
  139.         CalcR:=PaintR;
  140.  
  141.         for count:=0 to (Width-1) do
  142.         begin
  143.                 PaintR:=CalcR;
  144.                 InflateRect(PaintR,-1*(count),-1*(count));
  145.  
  146.                 ThePen := CreatePen(ps_Solid,1,RGB(127,127,127));
  147.                 OldPen := SelectObject(PaintDC,ThePen);
  148.                 MoveTo(PaintDC,PaintR.right,PaintR.top);
  149.                 LineTo(PaintDC,PaintR.left,PaintR.top);
  150.                 LineTo(PaintDC,PaintR.left,PaintR.bottom);
  151.                 SelectObject(PaintDC,OldPen);
  152.                 DeleteObject(ThePen);
  153.  
  154.                 ThePen := CreatePen(ps_Solid,1,RGB(255,255,255));
  155.                 OldPen := SelectObject(PaintDC,ThePen);
  156.                 MoveTo(PaintDC,PaintR.right,PaintR.top+1);
  157.                 LineTo(PaintDC,PaintR.right,PaintR.bottom);
  158.                 LineTo(PaintDC,PaintR.left-1,PaintR.bottom);
  159.                 SelectObject(PaintDC,OldPen);
  160.                 DeleteObject(ThePen);
  161.         end;
  162. end;
  163.  
  164. procedure DrawDivLine(PaintDC:HDC;Y:integer;Width:integer);
  165. var ThePen,OldPen:HPen;
  166.                 FillBrush,OldBrush:HBrush;
  167.                 count:integer;
  168. begin
  169.                 ThePen := CreatePen(ps_Solid,Width,RGB(127,127,127));
  170.                 OldPen := SelectObject(PaintDC,ThePen);
  171.                 MoveTo(PaintDC,GetSystemMetrics(sm_CXScreen),Y);
  172.                 LineTo(PaintDC,0,Y);
  173.                 SelectObject(PaintDC,OldPen);
  174.                 DeleteObject(ThePen);
  175.                 Y:=Y+Width;
  176.                 ThePen := CreatePen(ps_Solid,Width,RGB(255,255,255));
  177.                 OldPen := SelectObject(PaintDC,ThePen);
  178.                 MoveTo(PaintDC,GetSystemMetrics(sm_CXScreen),Y);
  179.                 LineTo(PaintDC,0,Y);
  180.                 SelectObject(PaintDC,OldPen);
  181.                 DeleteObject(ThePen);
  182. end;
  183.  
  184. procedure DrawDotLine(PaintDC:HDC;PaintR:TRect;Incr:integer);
  185. var ROP2:integer;
  186.                 count:integer;
  187. begin
  188.         ROP2 := GetROP2(PaintDC);
  189.         SetROP2(PaintDC,r2_Not);
  190.         count := PaintR.left;
  191.         while count < PaintR.right-1 do
  192.                 begin
  193.                         SetPixel(PaintDC,count,PaintR.top,$00000000);
  194.                         SetPixel(PaintDC,count,PaintR.bottom-1,$00000000);
  195.                         count := count + Incr;
  196.                 end;
  197.         count := PaintR.top+2;
  198.         while count < PaintR.bottom-1 do
  199.                 begin
  200.                         SetPixel(PaintDC,PaintR.left,count,$00000000);
  201.                         SetPixel(PaintDC,PaintR.right-1,count,$00000000);
  202.                         count := count + Incr;
  203.                 end;
  204.         SetROP2(PaintDC,ROP2);
  205. end;
  206.  
  207.  
  208. function MakeBorBrush(HWindow:HWnd;BackColor1,BackColor2:TColorRef):HBrush;
  209. var DC,MemDC:HDC;
  210.                 Bits:HBitmap;
  211.                 FillR:TRect;
  212.                 TheBrush,OldBrush:HBrush;
  213. begin
  214.         DC:=CreateDC('display',nil,nil,nil);
  215.         MemDC:=CreateCompatibleDC(DC);
  216.         Bits:=CreateCompatibleBitmap(DC,8,8);
  217.         SelectObject(MemDC,Bits);
  218.         if Bits<>0 then
  219.         begin
  220.                 TheBrush:=CreateSolidBrush(GetNearestColor(DC,BackColor2));
  221.                 OldBrush:=SelectObject(MemDC,TheBrush);
  222.                 PatBlt(MemDC,0,0,8,8,Blackness);
  223.                 with FillR do begin
  224.                         left:=0;right:=8;top:=0;bottom:=8;
  225.                 end;
  226.                 FillRect(MemDC,FillR,TheBrush);
  227.                 SelectObject(MemDC,OldBrush);
  228.                 DeleteObject(TheBrush);
  229.                 SetPixel(MemDC,0,0,BackColor1);
  230.                 SetPixel(MemDC,0,2,BackColor1);
  231.                 SetPixel(MemDC,0,4,BackColor1);
  232.                 SetPixel(MemDC,0,6,BackColor1);
  233.                 SetPixel(MemDC,2,0,BackColor1);
  234.                 SetPixel(MemDC,2,2,BackColor1);
  235.                 SetPixel(MemDC,2,4,BackColor1);
  236.                 SetPixel(MemDC,2,6,BackColor1);
  237.                 SetPixel(MemDC,4,0,BackColor1);
  238.                 SetPixel(MemDC,4,2,BackColor1);
  239.                 SetPixel(MemDC,4,4,BackColor1);
  240.                 SetPixel(MemDC,4,6,BackColor1);
  241.                 SetPixel(MemDC,6,0,BackColor1);
  242.                 SetPixel(MemDC,6,2,BackColor1);
  243.                 SetPixel(MemDC,6,4,BackColor1);
  244.                 SetPixel(MemDC,6,6,BackColor1);
  245.                 MakeBorBrush:=CreatePatternBrush(Bits);
  246.         end else MakeBorBrush:=0;
  247.         DeleteDC(MemDC);
  248.         DeleteDC(DC);
  249.         DeleteObject(Bits);
  250. end;
  251.  
  252. procedure DrawExplodeFrame(PaintDC:HDC;ExplR:TRect;PenColor,BrushColor:TColorRef;DrawBrush:boolean;Width:integer;
  253.                         Steps:integer;Pause:longint);
  254. var        count:integer;
  255.                 dX,dY:double;
  256.                 ThePen,OldPen:HPen;
  257.                 TheBrush,OldBrush:HBrush;
  258.                 OrigR:TRect;
  259.                 TimeCount:longint;
  260. begin
  261.         ThePen := CreatePen(ps_Dot,Width,PenColor);
  262.         OldPen := SelectObject(PaintDC,ThePen);
  263.         if DrawBrush then
  264.                 TheBrush:=CreateSolidBrush(BrushColor) else
  265.                 TheBrush := GetStockObject(Null_Brush);
  266.         OldBrush:= SelectObject(PaintDC,TheBrush);
  267.         dY:=(ExplR.bottom-ExplR.top)/Steps;
  268.         dX:=(ExplR.right-ExplR.left)/Steps;
  269.         with ExplR do
  270.         begin
  271.                 left:=left+((right-left) div 2);
  272.                 top:=top+((bottom-top) div 2);
  273.                 right:=left;bottom:=top;
  274.         end;
  275.         OrigR:=ExplR;
  276.         for count:=1 to steps do
  277.         begin
  278.                 with ExplR do
  279.                 begin
  280.                         TimeCount := GetTickCount;
  281.                         left:=OrigR.left-integer(Round(dX*count));
  282.                         right:=OrigR.right+integer(Round(dX*count));
  283.                         bottom:=OrigR.bottom-integer(Round(dY*count));
  284.                         top:=OrigR.top+integer(Round(dY*count));
  285.                         Rectangle(PaintDC,left,top,right,bottom);
  286.                         while (GetTickCount - TimeCount) < Pause do begin end;
  287.                 end;
  288.         end;
  289.         SelectObject(PaintDC,OldBrush);
  290.         DeleteObject(TheBrush);
  291.         SelectObject(PaintDC,OldPen);
  292.         DeleteObject(ThePen);
  293. end;
  294.  
  295. begin
  296. end.
  297.